%{

(*
This file is part of the Lustre reader

* Copyright (c) 2010, Nicola Camuffo.
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are met:
*     * Redistributions of source code must retain the above copyright
*       notice, this list of conditions and the following disclaimer.
*     * Redistributions in binary form must reproduce the above copyright
*       notice, this list of conditions and the following disclaimer in the
*       documentation and/or other materials provided with the distribution.
*     * Neither the name of Nicola Camuffo, nor the
*       names of its contributors may be used to endorse or promote products
*       derived from this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER ''AS IS'' AND ANY
* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE FOR ANY
* DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
* LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)


open Lustypes
open Lustables
open Mantypes
open Envs
open Exceptions
(*open Errmessages*)
open Utils
(*open Evaluation*)
open Doubtstables



(* catches-and-throws *)
let cat f msg =
	try
		f ()
	with exn -> raise (Parse_mismatch_exception (msg,Some exn))

(*	
(* catches-and-trows with same message *)
let mcat f =(
	try
		f ()
	with
		Parse_mismatch_exception (s,_) as exn -> raise (Parse_mismatch_exception (s,Some exn))	
		| Type_mismatch_exception (s,_) as exn -> raise (Parse_mismatch_exception (s,Some exn))	
		| Utils_exception s as exn -> raise (Parse_mismatch_exception (s,Some exn))	
		| Data_not_found_exception s as exn -> raise (Parse_mismatch_exception (s,Some exn))	
		| Data_already_exists_exception s as exn -> raise (Parse_mismatch_exception (s,Some exn))
		| Environment_exception (s,_) as exn -> raise (Parse_mismatch_exception (s,Some exn))	
		| exn ->
			let msg = "Unknown error." in
			raise (Parse_mismatch_exception (msg,Some exn))	
)
*)


	



(* tables and functions in order to save temporarily the list of constant names of an enum *)

(* enum id -> constants names *)
let enumconstshash = (Hashtbl.create 10 : (_id,_sym list)Hashtbl.t)

let save_enum_consts = Hashtbl.replace enumconstshash

let load_enum_consts = Hashtbl.find enumconstshash




(* these functions are used to recognize constant name as enum field *)

(* returns all enums defined in a given environment *)
let all_enum_type_ids eid =
	let msg = "Unable to find enums in the environment." in

	cat (fun _ ->
		let ids = get_contained eid in
		
		List.filter (fun id ->
			try
				let tp = get_typevalue id in
				match tp with
					T_ENUM _ -> true
					| _ -> false
			with
				(* it isn't a type *)
				Data_not_found_exception _ -> false
		) ids
	) msg
	
(* given an enum id it returns the list of constant names *)	
let enum_type_constant_names id =
	let msg1 = "Unable to find enum constant names." in
	
	cat (fun _ ->
		let tp = get_typevalue id in
		match tp with
			T_ENUM(l) -> l
			| _ ->
				let msg2 = "Type is not enum." in
				raise (Parse_mismatch_exception (msg2,None))
	) msg1



(* simple id generator for each entity (e.g. package, node, variable *)
let next_id () = idcounter#next



(* determines if an entity is provided by a specified package/model *)
let is_provided pid id =
	let msg = "The package/model doesn't provides anything." in 
	cat (fun _ ->
		let l = get_provided pid in
		List.mem id l
	) msg


(* identifiers *)
type _ide = {
  env_name: _sym option;
  ide_name: _sym
}

(* variables *)
type _var = {
  var_name: _sym;
  var_type: _type;
  var_value: _expression option
}

(* array select *)
type _select = {
  inf: _typed_expression;
  sup: _typed_expression;
  step: _typed_expression
}

(* nodes/functions profile *)
type _profile = {
  inputs: _id list;
  outputs: _id list
}

(* nodes/functions *)
type _node = {
  node_name: string;
  profile: _profile
}


let indentref_to_string ide = match ide.env_name with
	None -> ide.ide_name
	| Some s -> s ^ "::" ^ ide.ide_name
	


(* given an identifier and a function it scans all environments until the function (e.g. 'get_constid') is successful *)
let internal_identref_id f idref =
	let sym = idref.ide_name in
	
	match idref.env_name with

		(* the identifier belongs to current environment *)
		None ->
			let rec loop n =
				let msg = "'" ^ sym ^ "' not found in any environment." in
				
				cat (fun _ ->
					try
						let eid = get_nth_env n in
						f eid sym
					with
						(* raised by 'f' function *)
						Data_not_found_exception _ -> loop (n+1)
						
						(* if are raised other exceptions (by 'get_nth_env'), function 'cat' raises a 'Parse_mismatch_exception'  *)
				) msg
				
			in
			loop 0
			
		(* the identifier belongs to a specific environment (e.g. 'Pack::ide') *)
		| Some esym ->
			let msg1 = "'" ^ (indentref_to_string idref) ^ "' not recognized." in
				
			let eid,id = cat (fun _ ->
				let x = get_pm_id esym in
				let y = f x sym in
				x,y
			) msg1
			in
			
			(* is the identifier provided by its package/model? *)
			if (is_provided eid id) then
				id
			else
				let msg2 = "Package/model '" ^ esym ^ "' doesn't provide '" ^ sym ^ "' identifier." in
				raise (Parse_mismatch_exception (msg2,None))


(* specific 'internal_identref_id' *)

let internal_const_id = internal_identref_id get_constid

let internal_type_id = internal_identref_id get_typeid

let internal_node_id = internal_identref_id get_fn_id

(* gets enum id by its constant field name *)
let internal_enum_id = internal_identref_id (fun eid sym ->
  let ids = all_enum_type_ids eid in

  let rec loop l = match l with
    [] ->
			let msg = "No enum with constant named '" ^ sym ^ "' in the environment." in
			raise (Parse_mismatch_exception (msg,None))
    | x::xs ->
      let syml = enum_type_constant_names x in
      if (List.mem sym syml) then (
				save_enum_consts x syml;
				x
			)
      else
				loop xs
  in

  loop ids
)



(* create constants under various conditions *)

let define_const_without_expr sym typ =
	let msg = "Unable to define constant." in

  cat (fun _ ->
		let pid = current_env () in

		try

			(* constant previously provided *)
			let id = provided_id sym in
			let tp,vl = provided_const_info id in

			(* provided with different type *)
			if (tp <> typ) then ( (* WARNING: TYPES MUST BE EVALUATED IN ORDER TO BE COMPARED *)
				let msg = "Constant must have the same type in 'provides' statement." in
				raise (Parse_mismatch_exception (msg,None))
			);

			match vl with

				(* provided without assignment *)
				E_NONE ->
					add_const pid id sym typ E_NONE

				(* provided with assignment *)
				| _ ->
					let msg = "Constant cannot have assignment, like 'provides' statement." in
					raise (Parse_mismatch_exception (msg,None))


		with
			Not_found -> (* constant defined now first time as lv4 *)
				let id = next_id () in
				add_const pid id sym typ E_NONE

	) msg

let define_const_with_expr sym typ expr =
	let msg = "Unable to define constant." in

  cat (fun _ ->
		let pid = current_env () in

		try

			(* constant previously provided *)
			let id = provided_id sym in
			let tp,vl = provided_const_info id in

			(* provided with different type *)
			if (tp <> typ) then ( (* WARNING: TYPES MUST BE EVALUATED IN ORDER TO BE COMPARED *)
				let msg = "Constant must have the same type in 'provides' statement." in
				raise (Parse_mismatch_exception (msg,None))
			);

			match vl with

				(* provided without assignment *)
				E_NONE ->
					let value = fst expr in
					add_const pid id sym typ value

				(* provided with assignment *)
				| v ->
					if (v = fst expr) then (* WARNING: EXPRESSIONS MUST BE EVALUATED IN ORDER TO BE COMPARED *)
						add_const pid id sym typ v
					else
						let msg = "Constant must have assignment, like 'provides' statement." in
						raise (Parse_mismatch_exception (msg,None))


		with
			Not_found -> (* constant defined now first time as lv4 *)
				let id = next_id () in
					let value = fst expr in
					add_const pid id sym typ value

	) msg

let define_const_without_type sym expr =
	let msg = "Unable to define constant." in

  cat (fun _ ->
		let pid = current_env () in

		try

			(* constant previously provided *)
			let id = provided_id sym in
			let tp,vl = provided_const_info id in

			match vl with

				(* provided without assignment *)
				E_NONE ->
					let value = fst expr in
					add_const pid id sym tp value

				(* provided with assignment *)
				| v ->
					if (v = fst expr) then (* WARNING: EXPRESSIONS MUST BE EVALUATED IN ORDER TO BE COMPARED *)
						add_const pid id sym tp v
					else
						let msg = "Constant must have assignment, like 'provides' statement." in
						raise (Parse_mismatch_exception (msg,None))


		with
			Not_found -> (* constant defined now first time as lv4 *)
				let id = next_id () in
				let value = fst expr in
				let typ = snd expr in
				add_const pid id sym typ value

	) msg

	
(* create types under different conditions *)
	
let define_type_with_value sym typ =
	let msg = "Unable to define type." in

  cat (fun _ ->
		let pid = current_env () in

		try

			(* type previously provided *)
			let id = provided_id sym in
			let vl = provided_type_info id in

			match vl with

				(* provided without assignment *)
				T_NONE ->
					add_type pid id sym typ

				(* provided with assignment *)
				| v ->
					if (v = typ) then (* WARNING: TYPES MUST BE EVALUATED IN ORDER TO BE COMPARED *)
						add_type pid id sym v
					else
						let msg = "Type must have assignment, like 'provides' statement." in
						raise (Parse_mismatch_exception (msg,None))


		with
			Not_found -> (* type defined now first time as lv4 *)
				let id = next_id () in
				add_type pid id sym typ

	) msg

let define_type_without_value sym =
	let msg = "Unable to define type." in

  cat (fun _ ->
		let pid = current_env () in

		try

			(* type previously provided *)
			let id = provided_id sym in
			let vl = provided_type_info id in

			match vl with

				(* provided without assignment *)
				T_NONE ->
					add_type pid id sym T_NONE

				(* provided with assignment *)
				| _ ->
					let msg = "Type cannot have assignment, like 'provides' statement." in
					raise (Parse_mismatch_exception (msg,None))

		with
			Not_found -> (* type defined now first time as lv4 *)
				let id = next_id () in
				add_type pid id sym T_NONE

	) msg
			
%}

/* files */
%token INCLUDE

/* packages */
%token PACKAGE
%token END
%token BODY
%token USES
%token PROVIDES
%token MODEL
%token NEEDS
%token IS

/* constants definitions */
%token CONST

/* types definitions */
%token TYPE
%token STRUCT
%token ENUM
%token OF
%token ARRAYOF
%token INT
%token REAL
%token BOOL

/* nodes & functions definitions */
%token EXTERN
%token NODE
%token FUNCTION
%token RETURNS
%token VAR
%token LET
%token TEL

/* tuple selection */
%token STEP
%token DOUBLEDOT

/* binary operators */
%token MINUS
%token PLUS
%token DIV
%token MULT
%token INTDIV
%token MOD
%token AND
%token XOR
%token OR
%token IMPL
%token LTE
%token GTE
%token LT
%token GT
%token EQ
%token NEQ

/* unary operators */
%token MIRROR
%token NOT

/* n-ary operators */
%token EXCL
%token NOR

/* temporal operators */
%token PRE
%token ARROW
%token WHEN
%token CURRENT

/* conditional operators */
%token IF
%token THEN
%token ELSE
%token WITH

/* values */
%token TRUE
%token FALSE
%token <string> FLOAT
%token <string> NUM
%token <string> SYM
%token STRING /* must be parametrized! */

/* assertions */
%token ASSERT

/* symbols */
%token SEMICOLON
%token LBRACE
%token RBRACE
%token LSQBRACKET
%token RSQBRACKET
%token LPAREN
%token RPAREN
%token COLON
%token DOUBLECOLON
%token COMMA
%token DOT
%token PERCENT
%token LGUILLEMET
%token RGUILLEMET

/* scade */
%token <string> METAPROPERTY
%token MAIN_NODE
%token <string> CONVERT_TO
%token <string> CONVERT_FROM
%token PROPERTY
%token CONDACT
%token CONDACT
%token FBY

%token EOF_TOK


%right ARROW
%left IMPL
%left OR XOR
%left AND
%left NOT
%nonassoc EQ LT GT LTE GTE NEQ IF WITH THEN ELSE LSQBRACKET RSQBRACKET LPAREN RPAREN LBRACE RBRACE
%left MINUS PLUS
%left ARRAYOF
%left MULT DIV INTDIV MOD
%left UMINUS
%left PRE FBY

%start main
%type < unit > main
%%


main:
  lustre_file EOF_TOK
  {  }

lustre_file:
  lustre_code
  {  }
/*
| include_list lustre_code
  {  }

include_list:
  include_stmt
  {  }
| include_stmt include_list
  {  }

include_stmt:
  INCLUDE str
  {
    (* current_file_id := next_id (); *)

    (* TODO *)
  }
*/

lustre_code:
  pack_body
  {
    (* lv4 *)
	}
| pack_list
  {  }

	
pack_list:
  one_pack
  {  }
| one_pack pack_list
  {  }

one_pack:
  model_decl
  {  }
| package_decl
  {  }
| model_inst_decl
  {  }


model_decl:
  MODEL model_name uses model_formal_static_params SEMICOLON provides BODY pack_body pack_end
  {
		let msg = "Unable to define model." in

		cat (fun _ ->
			let pid = current_env () in

			List.iter (fun id -> set_as_used pid id) $3;
			List.iter (fun id -> set_as_needed pid id) $4;
			List.iter (fun id -> set_as_provided pid id) $6;

			(* TODO BODY *)

		) msg
  }

model_name:
  ident
  {
		let msg = "Unable to define model name." in

		cat (fun _ ->
			let pid = next_id () in
			open_new_env pid;

			add_model $1 pid;

			pid
		) msg
  }

package_decl:
  PACKAGE package_name uses provides BODY pack_body pack_end
  {
		let msg = "Unable to define package." in
		
		cat (fun _ ->
			let pid = current_env () in

			List.iter (fun id -> set_as_used pid id) $3;
			List.iter (fun id -> set_as_provided pid id) $4;

			(* TODO BODY *)

		) msg
  }

package_name:
  ident
  {
		let msg = "Unable to define package name." in

		cat (fun _ ->
			let pid = next_id () in
			open_new_env pid;

			add_package $1 pid;

			pid
		) msg
  }

pack_end:
	END
	{
		close_env ()
	}
	
model_inst_decl:
  PACKAGE ident eq_or_is ident actual_params SEMICOLON
  {
    (* TODO *)
  }



provides:
  {
    []
  }
| PROVIDES provide_list
  {
    $2
  }

provide_list:
  provide SEMICOLON
  {
    [$1]
  }
| provide SEMICOLON provide_list
  {
    $1 :: $3
  }

provide:
  TYPE ident
  {
		let msg = "Unable to provide type." in

		cat (fun _ ->
			let id = next_id () in
			provide_type id $2 T_NONE;

			id
		) msg	
  }
| TYPE ident EQ data_type
  {
		let msg = "Unable to provide type." in

		cat (fun _ ->
			let id = next_id () in
			provide_type id $2 $4;

			id
		) msg	
  }
| CONST ident COLON normal_type opt_const_def
  {
		let msg = "Unable to provide constant." in

		cat (fun _ ->
			let id = next_id () in
			provide_const id $2 $4 $5;

			id
		) msg	
  }
| node_header
  {
		let msg = "Unable to provide node." in

		cat (fun _ ->
			let nid = next_id () in
			provide_node nid $1.node_name $1.profile.inputs $1.profile.outputs;

			nid
		) msg	
  }
| function_header
  {
		let msg = "Unable to provide node." in

		cat (fun _ ->
			let nid = next_id () in
			provide_func nid $1.node_name $1.profile.inputs $1.profile.outputs;

			nid
		) msg	
  }


uses:
  {
    []
  }
| USES ident_list SEMICOLON
  {
    List.map (fun s ->
      (* does it exist?? *)
			let msg = "'" ^ s ^ "' is not a valid package or model." in
      cat (fun _ -> get_pm_id s) msg
    ) $2
  }



model_formal_static_params:
  NEEDS formal_static_param_list
  {
    $2
  }


actual_params:
  LPAREN by_name_actual_static_param_list RPAREN
  {  }



pack_body:
  decl_list
  {  }

decl_list:
  one_decl
  {  }
| one_decl decl_list
  {  }

one_decl:
  const_decl
  {  }
| type_decl
  {  }
| ext_node_decl
  {  }
| node_decl
  {  }









typed_idents_list:
  typed_idents
  {  }
| typed_idents SEMICOLON typed_idents_list
  {  }

typed_idents:
  ident_list COLON normal_type
  {
    List.map (fun s ->
      { var_name = s; var_type = $3; var_value = None }
    ) $1
  }

typed_valued_idents:
  typed_valued_ident
  {
    [$1]
  }
| typed_valued_ident SEMICOLON typed_valued_idents
  {
    $1 :: $3
  }

typed_valued_ident:
  ident COLON normal_type
  {
    { var_name = $1; var_type = $3; var_value = None }
  }
/*
| ident COLON normal_type EQ expression
  {  }
*/




const_decl:
  CONST const_decl_list
  {  }

const_decl_list:
  one_const_decl SEMICOLON
  {  }
| one_const_decl SEMICOLON const_decl_list
  {  }

one_const_decl:
  ident COLON normal_type
  {
    define_const_without_expr $1 $3
  }
| ident COMMA ident_list COLON normal_type
  {
    List.iter (fun sym ->
      define_const_without_expr sym $5
    ) ($1 :: $3)
  }
| ident COLON normal_type EQ static_expr
  {
    define_const_with_expr $1 $3 $5
  }
| ident EQ static_expr
  {
    define_const_without_type $1 $3
  }

type_decl:
  TYPE type_decl_list
  {  }

type_decl_list:
  one_type_decl SEMICOLON
  {  }
| one_type_decl SEMICOLON type_decl_list
  {  }

one_type_decl:
  ident_list
  {
    List.iter (fun sym ->
      define_type_without_value sym
    ) $1
  }
| ident EQ data_type
  {
    define_type_with_value $1 $3
  }



data_type:
  normal_type
  {
    $1
  }
| enum_type
  {
    $1
  }
| struct_type
  {
    $1
  }

normal_type:
  base_type
  {
    $1
  }
| ident_ref
  {
		let msg = "Unable to use '" ^ (indentref_to_string $1) ^ "' reference. Is it a type alias?" in
		
		cat (fun _ ->
			let id = internal_type_id $1 in
			let value = get_typevalue id in

			match value with
				T_NONE -> T_NAMED(id) (* not assigned type *)
				| v -> v
		) msg
  }
| normal_type ARRAYOF static_expr
  {
    T_ARRAY($1,$3)
  }



enum_type:
  ENUM LBRACE ident_list RBRACE
  {
    T_ENUM $3
  }

struct_type:
  opt_struct LBRACE typed_valued_idents RBRACE
  {
    let l = List.map (fun x -> (x.var_name,x.var_type)) $3 in
    T_STRUCT l
  }
/* lv4 */
| LSQBRACKET typed_valued_idents RSQBRACKET
  {
    let l = List.map (fun x -> (x.var_name,x.var_type)) $2 in
    T_STRUCT l
  }





ext_node_decl:
  EXTERN node_header opt_semicol
  {  }
| EXTERN function_header opt_semicol
  {  }

node_decl:
  local_node
  {  }

local_node:
  NODE node_name opt_node_formal_static_params node_profile opt_semicol locals body opt_end_node
  {
		let msg = "Unable to define node." in
		
		cat (fun _ ->
			let nid = current_env () in

			let ins = $4.inputs in
			let outs = $4.outputs in

			List.iter (fun id -> add_input nid id) ins;
			List.iter (fun id -> add_output nid id) outs;
			List.iter (fun id -> add_local nid id) $6;

			(* TODO BODY *)

			close_env ()
		) msg	
  }
| FUNCTION function_name opt_node_formal_static_params node_profile opt_semicol locals body opt_end_node
  {  }
| NODE node_name opt_node_formal_static_params opt_node_profile EQ effective_node opt_semicol
  {  }
| FUNCTION function_name opt_node_formal_static_params opt_node_profile EQ effective_node opt_semicol
  {  }


node_name:
  ident
  {
		let msg = "Unable to define node name." in

		cat (fun _ ->
			let eid = current_env () in

			let nid = next_id () in
			open_new_env nid;

			add_node eid nid $1;

			nid
		) msg	
  }

function_name:
  ident
  {
		let msg = "Unable to define function name." in

		cat (fun _ ->
			let eid = current_env () in

			let nid = next_id () in
			open_new_env nid;

			add_function eid nid $1;

			nid
		) msg	
  }


opt_node_profile:
  {
    None
  }
| node_profile
  {
    Some $1
  }

node_profile:
  inputs RETURNS outputs
  {
    { inputs = $1; outputs = $3 }
  }

opt_node_formal_static_params:
  {  }
| LGUILLEMET formal_static_param_list RGUILLEMET
  {  }

formal_static_param_list:
  formal_static_param
  {
    [$1]
  }
| formal_static_param SEMICOLON formal_static_param_list
  {
    $1 :: $3
  }

formal_static_param:
  TYPE ident
  {
		let msg = "Unable to define type as formal static parameter." in

		cat (fun _ ->
			let eid = current_env () in
			let id = next_id () in

			(* formal parameter (not assigned reference) *)
			add_type eid id $2 T_NONE;

			id
		) msg
  }
| CONST ident COLON normal_type
  {
		let msg = "Unable to define constant as formal static parameter." in

		cat (fun _ ->
			let eid = current_env () in
			let id = next_id () in

			(* formal parameter (not assigned reference) *)
			add_const eid id $2 $4 E_NONE;

			id
		) msg
  }
| node_header
  {
		let msg = "Unable to define node as formal static parameter." in

		cat (fun _ ->
			let eid = current_env () in
			let nid = next_id () in

			let name = $1.node_name in
			let ins = $1.profile.inputs in
			let outs = $1.profile.outputs in

			add_node eid nid name;

			(* vars already created; formal parameter (without body) *)
			List.iter (fun id -> add_input nid id) ins;
			List.iter (fun id -> add_output nid id) outs;

			nid
		) msg
  }
| function_header
  {
		let msg = "Unable to define function as formal static parameter." in

		cat (fun _ ->
			let eid = current_env () in
			let nid = next_id () in

			let name = $1.node_name in
			let ins = $1.profile.inputs in
			let outs = $1.profile.outputs in

			add_function eid nid name;

			(* vars already created; formal parameter (without body) *)
			List.iter (fun id -> add_input nid id) ins;
			List.iter (fun id -> add_output nid id) outs;

			nid
		) msg
  }


node_header:
  NODE ident node_profile
  {
    { node_name = $2; profile = $3 }
  }

function_header:
  FUNCTION ident node_profile
  {
    { node_name = $2; profile = $3 }
  }



inputs:
  LPAREN RPAREN
  {
    []
  }
| params
  {
    $1
  }

outputs:
  params
  {
    $1
  }

locals:
  {
    []
  }
| VAR var_decl_list SEMICOLON
  {
    $2
  }


params:
  LPAREN var_decl_list opt_semicol RPAREN
  {
    $2
  }


var_decl_list:
  var_decl
  {
    $1 (* already list *)
  }
| var_decl_list SEMICOLON var_decl
  {
    $1 @ $3
  }

var_decl:
  typed_idents
  {
		let msg = "Unable to declare variables." in

		cat (fun _ ->
			let nid = current_env () in

			List.map (fun v ->
				let id = next_id () in
				add_var nid v.var_name id v.var_type;

				id
			) $1
		) msg
  }
/*
| typed_idents WHEN clock_expr
  {  }
| LPAREN typed_idents_list RPAREN WHEN clock_expr
  {  }
| CONST typed_idents
  {
    (* lv4 *)
  }
*/


body:
  LET TEL
  {  }
| LET equation_list TEL
  {  }

equation_list:
  equation
  {
    [$1]
  }
| equation equation_list
  {
    $1 :: $2
  }

equation:
  ASSERT expression SEMICOLON
	{
		let msg = "Unable to set the expression as assertion." in
		cat (fun _ ->
			verify_boolean $2;
		
			let nid = current_env () in
			add_assert nid $2
		) msg
	}
| left EQ expression SEMICOLON
  {
		let lhs = match $1 with
			[] ->
				let msg1 = "There are not lhs items!!!!" in
				raise (Parse_mismatch_exception (msg1,None))
			| [x] -> x
			| l ->
				let tl = List.map (fun (_,t) -> t) l in
				L_LIST(l),T_LIST(tl)
		in
		
		let msg2 = "Unable to assign rhs to lhs." in
		
		cat (fun _ ->
			match_types_for_assignment lhs $3;
		
			let nid = current_env () in
			add_assigned_expr nid lhs $3
		) msg2
	}

left:
  left_item_list
  {
    $1
  }
| LPAREN left_item_list RPAREN
  {
    $2
  }

left_item_list:
  left_item
  {
    [$1]
  }
| left_item COMMA left_item_list
  {
    $1 :: $3
  }

left_item:
  ident
  {
		let msg1 = "Unable to use '" ^ $1 ^ "' reference. Is it a valid lhs item?" in

		cat (fun _ ->
			let nid = current_env () in

			let msg2 = "'" ^ $1 ^ "' is not a variable or is not initialized." in
			
			cat (fun _ ->
				let id = get_varid nid $1 in
				let tp = get_vartype id in

				L_VAR(id),tp
			) msg2
		) msg1
	}
| left_item DOT ident
  {
		let msg1 = "'" ^ $3 ^ "' is not a valid field name." in
		let msg2 = "The item on the left of '.' is not a struct." in
		
		match $1 with
			_,T_STRUCT(l) -> (
				cat (fun _ ->
					let tp = List.assoc $3 l in
					L_STRUCTSEL($1,$3),tp
				) msg1
			)

			| _,_ -> raise (Parse_mismatch_exception (msg2,None))
	}
| left_item LSQBRACKET select RSQBRACKET
  {
		let msg = "The item on the left of '[..]' is not a tuple." in

		match $1 with
			_,T_TUPLE(_) ->
				L_TUPLESEL($1,$3.inf,$3.sup,$3.step),T_TOCHECK (* the type of the field is unknown because expression bounds are not evaluated *)

			|_,T_ARRAY(_,_) ->
				L_TUPLESEL($1,$3.inf,$3.sup,$3.step),T_TOCHECK (* the type of the field is known but expression bounds are not evaluated *)
			
			| _,_ -> raise (Parse_mismatch_exception (msg,None))
	}


expression:
  simple_expr
  {
    $1
  }
| LPAREN expression RPAREN
  {
    $2
  }
| PRE expression
  {
    let _,tp = $2 in
    E_PRE($2),tp
  }

	
	/*
| CURRENT expression
  {  }
| INT expression
  {  }
| REAL expression
  {  }

| BOOL expression
  {  }

| expression WHEN clock_expr
  {
    let tp = match_types_clocked $1 $3 in
    E_WHEN($1,$3),tp
  }

| expression FBY expression
  {  }
*/


| expression ARROW expression
  {
		let msg = "Invalid 'a -> b' expression." in
		
		cat (fun _ ->
			let tp = match_types_follby $1 $3 in
			E_FOLLOWEDBY($1,$3),tp
		) msg
  }
	
	
/*
| WITH expression THEN expression ELSE expression
  {  }
| EXCL LPAREN expression_list RPAREN
  {  }
| NOR LPAREN expression_list RPAREN
  {  }
*/


| node_call
  {
    $1
  }
| LSQBRACKET expression_list RSQBRACKET
  {
		let _,tp = List.split $2 in
		E_TUPLE($2),T_TUPLE(tp)
  }
	
	
/*
| expression ARRAYOF expression
  {  }
| expression '|' expression
  {  }
| expression LSQBRACKET select RSQBRACKET
  {  }
| expression DOT ident
  {  }
| call_by_name_expression
  {  }
*/

clock_expr:
  ident LPAREN ident RPAREN
  {  }
| ident
  {  }
| NOT ident
  {  }
| NOT LPAREN ident RPAREN
  {  }



static_expr:
  simple_expr
  {
    $1
  }
| LPAREN static_expr RPAREN
  {
    $2
  }
| static_expr LSQBRACKET static_select RSQBRACKET
  {
    E_TUPLESEL($1,$3.inf,$3.sup,$3.step),T_TOCHECK (* to check that $1 is a tuple and bounds are rights *)
  }
| static_expr ARRAYOF static_expr
	{
		let msg = "Invalid 'a ^ b' expression." in
		
		cat (fun _ ->
			verify_integer $3;
			
			let _,tp = $1 in
			E_ARRAY($1,$3),T_ARRAY(tp,$3)
		) msg
  }
| EXCL LPAREN static_expr_list RPAREN
	{
		let msg = "Invalid '# (a,b,c..)' expression." in
		
		cat (fun _ ->
			let tp = match_types_bool_nary $3 in
			E_EXCL($3),tp
		) msg
  }
| NOR LPAREN static_expr_list RPAREN
	{
		let msg = "Invalid 'nor (a,b,c..)' expression." in
		
		cat (fun _ ->
			let tp = match_types_bool_nary $3 in
			E_NOR($3),tp
		) msg
  }


static_expr_list:
  static_expr
  {
    [$1]
  }
| static_expr COMMA static_expr_list
  {
    $1 :: $3
  }




predef_op:
  NOT
  {  }
| FBY
  {  }
| PRE
  {  }
| CURRENT
  {  }
| ARROW
  {  }
| WHEN
  {  }
| AND
  {  }
| OR
  {  }
| XOR
  {  }
| IMPL
  {  }
| EQ
  {  }
| NEQ
  {  }
| LT
  {  }
| LTE
  {  }
| GT
  {  }
| GTE
  {  }
| INTDIV
  {  }
| MOD
  {  }
| MINUS
  {  }
| PLUS
  {  }
| DIV
  {  }
| MULT
  {  }
| IF
  {  }
| WHEN clock_expr
  {  }

node_call:
  effective_node LPAREN RPAREN
  {
    let localnid = $1 in

    (* verifies number of parameters *)
    (
    try
      ignore(get_inputs localnid);
			
			let msg1 = "The called node is defined with some parameters!!" in
      raise (Parse_mismatch_exception (msg1,None))
    with
      Data_not_found_exception _ -> ()
    );

    (* determines node type (single type or type list) *)
		let msg2 = "Unable to determine the type of node output." in
		
		cat (fun _ ->
			let outl = get_outputs localnid in
			let tl = List.map (fun id -> get_vartype id) outl in

			let tp = if (List.length tl) = 1 then
				List.hd tl
			else
				T_LIST(tl)
			in

			let ex = E_NODE(localnid,[]) in
			ex,tp
		) msg2
  }
| effective_node LPAREN expression_list RPAREN
  {
    let localnid = $1 in

    (* verifies number and type of parameters *)
		let msg1 = "Mismatch between formal and actual parameters!!" in

		cat (fun _ ->
			let inl = get_inputs localnid in
			let formals = List.map (fun id -> get_vartype id) inl in
			match_types_node_params $3 formals
    ) msg1;

    (* determines node type (single type or type list) *)
		let msg2 = "Unable to determine the type of node output." in
		
		cat (fun _ ->
			let outl = get_outputs localnid in
			let tl = List.map (fun id -> get_vartype id) outl in

			let tp = if (List.length tl) = 1 then
				List.hd tl
			else
				T_LIST(tl)
			in

			let ex = E_NODE(localnid,$3) in
			ex,tp
		) msg2
  }

effective_node:
  ident_ref
  {
		let msg = "Unable to use '" ^ (indentref_to_string $1) ^ "' reference. Is it a node/function?" in
		
		cat (fun _ ->
			internal_node_id $1
		) msg
  }
| effective_node_with_static_params
  {
    $1
  }

effective_node_with_static_params:
  ident_ref LGUILLEMET actual_static_param_list RGUILLEMET
  {
		let msg = "Unable to use '" ^ (indentref_to_string $1) ^ "' reference. Is it a node/function?" in
		
		cat (fun _ ->
			internal_node_id $1
		) msg
  }

actual_static_param_list:
  actual_static_param
  {
    [$1]
  }
| actual_static_param sep_variant actual_static_param_list
  {
    $1 :: $3
  }

actual_static_param:
  TYPE normal_type
  {  }
| CONST static_expr
  {  }
| NODE effective_node
  {  }
| FUNCTION effective_node
  {  }
| predef_op
  {  }
| simple_expr
  {  }
| surely_type
  {  }
| effective_node_with_static_params
  {  }


surely_type:
  base_type
  {
    $1
  }
| surely_type ARRAYOF static_expr
  {
    T_ARRAY($1,$3)
  }



simple_expr:
  boolean
  {
    E_BOOL($1),T_BOOL
  }
| integer
  {
    E_INT($1),T_INT
  }
| real
  {
    E_REAL($1),T_REAL
  }
| ident_ref
  {
		let msg = "Unable to use '" ^ (indentref_to_string $1) ^ "' reference. Is it a constant/variable?" in
		let nid = cat (fun _ -> current_env ()) msg in

    try

      (* is it a constant? *)
      let id = internal_const_id $1 in

      let tp,vl = get_constvalue id in
      match vl with
				E_NONE -> E_CONST(id),tp (* not assigned constant *)
				| v -> v,tp

    with
			(Data_not_found_exception _) as exn -> raise (Parse_mismatch_exception (msg,Some exn))
			
      (* not exists constant in any environment *)
      | Parse_mismatch_exception (_,_) -> (

			try
				(* is it a variable? *)
				let id = get_varid nid $1.ide_name in

				let tp = cat (fun _ -> get_vartype id) msg in
				E_VAR(id),tp

			(* neither constant nor variable *)
			with Data_not_found_exception _ -> (

				try
					(* is it an enum constant? *)
					let id = internal_enum_id $1 in

					let syml = cat (fun _ -> load_enum_consts id) msg in
					E_ENUMSEL(id,$1.ide_name),(T_ENUM(syml))

				with Parse_mismatch_exception (_,_) ->
					raise (Parse_mismatch_exception (msg,None))

			)
		)
  }
| LPAREN simple_expr RPAREN
  {
    $2
  }
| simple_expr AND simple_expr
  {
		let msg = "Invalid 'a and b' expression." in
		
		cat (fun _ ->
			let tp = match_types_boolean $1 $3 in
			E_AND($1,$3),tp
		) msg
  }
| simple_expr OR simple_expr
  {
		let msg = "Invalid 'a or b' expression." in
		
		cat (fun _ ->
			let tp = match_types_boolean $1 $3 in
			E_OR($1,$3),tp
		) msg
  }
| simple_expr XOR simple_expr
  {
		let msg = "Invalid 'a xor b' expression." in
		
		cat (fun _ ->
			let tp = match_types_boolean $1 $3 in
			E_XOR($1,$3),tp
		) msg
  }
| simple_expr IMPL simple_expr
  {
		let msg = "Invalid 'a => b' expression." in
		
		cat (fun _ ->
			let tp = match_types_boolean $1 $3 in
			E_IMPL($1,$3),tp
		) msg
  }
| NOT simple_expr
  {
		let msg = "Invalid 'not a' expression." in
		
		cat (fun _ ->
			verify_boolean $2;
			
			let _,tp = $2 in
			E_NOT($2),tp
		) msg
  }
| simple_expr EQ simple_expr
  {
		let msg = "Invalid 'a = b' expression." in
		
		cat (fun _ ->
			let tp = match_types_equals $1 $3 in
			E_EQ($1,$3),tp
		) msg
  }
| simple_expr NEQ simple_expr
  {
		let msg = "Invalid 'a <> b' expression." in
		
		cat (fun _ ->
			let tp = match_types_equals $1 $3 in
			E_NEQ($1,$3),tp
		) msg
  }
| simple_expr LT simple_expr
  {
		let msg = "Invalid 'a < b' expression." in
		
		cat (fun _ ->
			let tp = match_types_ltge $1 $3 in
			E_LT($1,$3),tp
		) msg
  }
| simple_expr LTE simple_expr
  {
		let msg = "Invalid 'a <= b' expression." in
		
		cat (fun _ ->
			let tp = match_types_ltge $1 $3 in
			E_LTE($1,$3),tp
		) msg
  }
| simple_expr GT simple_expr
  {
		let msg = "Invalid 'a > b' expression." in
		
		cat (fun _ ->
			let tp = match_types_ltge $1 $3 in
			E_GT($1,$3),tp
		) msg
  }
| simple_expr GTE simple_expr
  {
		let msg = "Invalid 'a >= b' expression." in
		
		cat (fun _ ->
			let tp = match_types_ltge $1 $3 in
			E_GTE($1,$3),tp
		) msg
  }
| simple_expr INTDIV simple_expr
  {
		let msg = "Invalid 'a div b' expression." in
		
		cat (fun _ ->
			let tp = match_types_integer $1 $3 in
			E_INTDIV($1,$3),tp
		) msg
  }
| simple_expr MOD simple_expr
  {
		let msg = "Invalid 'a mod b' expression." in
		
		cat (fun _ ->
			let tp = match_types_integer $1 $3 in
			E_MOD($1,$3),tp
		) msg
  }
| simple_expr MINUS simple_expr
  {
		let msg = "Invalid 'a - b' expression." in
		
		cat (fun _ ->
			let tp = match_types_numeric $1 $3 in
			E_MINUS($1,$3),tp
		) msg
  }
| simple_expr PLUS simple_expr
  {
		let msg = "Invalid 'a + b' expression." in
		
		cat (fun _ ->
			let tp = match_types_numeric $1 $3 in
			E_PLUS($1,$3),tp
		) msg
  }
| simple_expr DIV simple_expr
  {
		let msg = "Invalid 'a / b' expression." in
		
		cat (fun _ ->
			let tp = match_types_numeric $1 $3 in
			E_DIV($1,$3),tp
		) msg
  }
| simple_expr MULT simple_expr
  {
		let msg = "Invalid 'a * b' expression." in
		
		cat (fun _ ->
			let tp = match_types_numeric $1 $3 in
			E_MULT($1,$3),tp
		) msg
  }
| MINUS simple_expr %prec UMINUS
  {
		let msg = "Invalid '-a' expression." in
		
		cat (fun _ ->
			verify_numeric $2;
			
			let _,tp = $2 in
			E_UMINUS($2),tp
		) msg
  }
| IF simple_expr THEN simple_expr ELSE simple_expr
  {
		let msg = "Invalid 'if a then b else c' expression." in
		
		cat (fun _ ->
			let tp = match_types_ite $2 $4 $6 in
			E_ITE($2,$4,$6),tp
		) msg
  }






by_name_actual_static_param_list:
  by_name_actual_static_param
  {  }
| by_name_actual_static_param sep_variant by_name_actual_static_param_list
  {  }

by_name_actual_static_param:
  TYPE ident EQ normal_type
  {  }
| CONST ident EQ static_expr
  {  }
| NODE ident EQ effective_node
  {  }
| FUNCTION ident EQ effective_node
  {  }
| ident EQ predef_op
  {  }
| ident EQ simple_expr
  {  }
| ident EQ surely_type
  {  }
| ident EQ effective_node_with_static_params
  {  }



call_by_name_expression:
  ident_ref LBRACE call_by_name_param_list opt_semicol RBRACE
  {  }
| ident_ref LBRACE RBRACE
  {  }

call_by_name_param_list:
  call_by_name_param
  {  }
| sep_variant call_by_name_param_list
  {  }




call_by_name_param:
  ident EQ expression
  {  }

expression_list:
  expression
  {
    [$1]
  }
| expression COMMA expression_list
  {
    $1 :: $3
  }





ident_ref:
  SYM
  {
    { env_name = None; ide_name = $1 }
  }
| SYM DOUBLECOLON SYM
  {
    { env_name = Some $1; ide_name = $3 }
  }

ident_list:
  ident
  {
    [$1]
  }
| ident COMMA ident_list
  {
    $1 :: $3
  }

ident:
  SYM
  {
    $1
  }
| SYM pragma_list
  {
    $1
  }


pragma_list:
  pragma
  {  }
| pragma pragma_list
  {  }

pragma:
  PERCENT SYM COLON SYM PERCENT
  {  }


integer:
  NUM
  {
    int_of_string $1
  }

real:
  FLOAT
  {
    float_of_string $1
  }

boolean:
  TRUE
  {
    true
  }
| FALSE
  {
    false
  }

str:
  STRING
  {
    (* $1 *)
  }


select:
  expression
  {
		let msg = "Invalid '[a]' tuple selection." in
		
		cat (fun _ ->
			verify_integer $1;
			
			{ inf = $1; sup = $1; step = (E_INT(1),T_INT) }
		) msg
  }
| expression DOUBLEDOT expression
  {
		let msg = "Invalid '[a..b]' tuple selection." in
		
		cat (fun _ ->
			verify_integer $1;
			verify_integer $3;
			
			{ inf = $1; sup = $3; step = (E_INT(1),T_INT) }
		) msg
  }
| expression DOUBLEDOT expression STEP expression
  {
		let msg = "Invalid '[a..b step c]' tuple selection." in
		
		cat (fun _ ->
			verify_integer $1;
			verify_integer $3;
			verify_integer $5;
			
			{ inf = $1; sup = $3; step = $5 }
		) msg
  }


static_select:
  static_expr
  {
		let msg = "Invalid simple tuple selection." in
		
		cat (fun _ ->
			verify_integer $1;
			
			{ inf = $1; sup = $1; step = (E_INT(1),T_INT) }
		) msg
  }
| static_expr DOUBLEDOT static_expr
  {
		let msg = "Invalid '[a..b]' tuple selection." in
		
		cat (fun _ ->
			verify_integer $1;
			verify_integer $3;
			
			{ inf = $1; sup = $3; step = (E_INT(1),T_INT) }
		) msg
  }
| static_expr DOUBLEDOT static_expr STEP static_expr
  {
		let msg = "Invalid '[a..b step c]' tuple selection." in
		
		cat (fun _ ->
			verify_integer $1;
			verify_integer $3;
			verify_integer $5;
			
			{ inf = $1; sup = $3; step = $5 }
		) msg
  }



base_type:
  BOOL
  {
    T_BOOL
  }
| INT
  {
    T_INT
  }
| REAL
  {
    T_REAL
  }



opt_const_def:
  {
    E_NONE
  }
| EQ static_expr
  {
		let value = fst $2 in
    value
  }


eq_or_is:
  EQ
  {  }
| IS
  {  }

sep_variant:
  SEMICOLON
  {  }
| COMMA
  {  }

opt_struct:
  {  }
| STRUCT
  {  }

opt_end_node:
  DOT
  {  }
| opt_semicol
  {  }

opt_semicol:
  {  }
| SEMICOLON
  {  }
